home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_msg < prev    next >
Encoding:
Text File  |  1991-08-14  |  3.1 KB  |  149 lines
  1. \ Demonstrate access to the Amiga message system.
  2. \
  3. \ Author: Phil Burk
  4. \ Copyright 1986 Delta Research
  5.  
  6. getmodule includes
  7. include? exec_libraries_h ji:exec/libraries.j
  8. include? CreatePort() ju:exec_support
  9. include? tolower ju:char-macros
  10.  
  11. ANEW TASK-DEMO_MSG
  12. decimal
  13.  
  14. ." WARNING - Version 2.0 had a faulty definition for FINDPORT()!" cr
  15. : FINDPORT()  ( name -- port )
  16.     if>abs call exec_lib findport if>rel
  17. ;
  18.  
  19. \ Define a custom message structure.
  20. :STRUCT JDMessage
  21.     struct Message jd_msg
  22.     long  JD_OPCODE   ( tell background to do something )
  23.     long  JD_DATA1
  24.     long  JD_DATA2
  25. ;STRUCT
  26.  
  27. \ Declare an instance of that structure.
  28. \ Data for foreground task.
  29. JDMessage JDMSG
  30. variable PORT-MADE
  31. variable PORT-FOUND
  32.  
  33. : MSG.MAKE ( 0name -- , Create a port to )
  34.     0 CreatePort()   ( -- rel_reply_port )
  35.     dup port-made !
  36.     0= abort" MSG.MAKE - Couldn't open port!"
  37. \
  38. \ Initialize message structure.
  39.     NT_MESSAGE jdmsg .. jdmsg .. mn_node ..! ln_type
  40.     NULL  jdmsg .. jdmsg ..! mn_ReplyPort
  41. ;
  42.  
  43. : MSG.FINDPORT ( 0name -- )
  44.     findport() ?dup
  45.     IF port-found !
  46.     ELSE ." MSG.FINDPORT couldn't find port!" cr abort
  47.     THEN
  48. ;
  49.  
  50. : MSG.SEND ( msg -- , Send message to other task )
  51.     port-found @ swap putmsg()
  52. ;
  53.  
  54. : MSG.RECV ( -- msg )
  55.     port-made @ WaitPort() drop
  56.     port-made @ GetMsg()
  57. ;
  58.  
  59. : MSG.TERM ( -- , cleanup )
  60.     port-made @
  61.     IF  port-made @ DeletePort()
  62.         port-made off
  63.     THEN
  64. ;
  65.  
  66. \ Send different kinds of messages to background.
  67. 0 constant JD_QUIT  ( tell background to go away )
  68. 1 constant JD_TYPE  ( print a message in data1 )
  69. 2 constant JD_EMIT  ( emit one char )
  70. 3 constant JD_ADD   ( add data1 and data2 and leave result in data1)
  71. variable MSG-QUIT
  72.  
  73. : MSG.EXEC  ( msg -- , background acts on message )
  74.     dup>r ..@ jd_opcode
  75.     CASE
  76.         jd_type OF r@ ..@ jd_data1 >rel count type cr ENDOF
  77.         jd_emit OF r@ ..@ jd_data1 emit flushemit  ENDOF
  78.         jd_add  OF r@ ..@ jd_data1
  79.             r@ ..@ jd_data2 + r@ ..! jd_data1
  80.         ENDOF
  81.     jd_quit OF msg-quit on ENDOF
  82.         ." Bad opcode! dup .
  83.     ENDCASE
  84.     rdrop  ( drop message )
  85. ;
  86.  
  87. \ You must pass addresses as ABSOLUTE just like when
  88. \ passing to the Amiga OS
  89. : MSG.TYPE  ( $string -- )
  90.     >abs jdmsg ..! jd_data1    ( note >ABS  )
  91.     jd_type jdmsg ..! jd_opcode
  92.     jdmsg msg.send msg.recv drop
  93. ;
  94.  
  95. : MSG.EMIT  ( char -- )
  96.     jdmsg ..! jd_data1
  97.     jd_emit jdmsg ..! jd_opcode
  98.     jdmsg msg.send msg.recv drop
  99. ;
  100.  
  101. : MSG.ADD ( a b -- a+b )
  102.     jdmsg ..! jd_data1
  103.     jdmsg ..! jd_data2
  104.     jd_add jdmsg ..! jd_opcode
  105.     jdmsg msg.send msg.recv drop
  106.     jdmsg ..@ jd_data1
  107. ;
  108.  
  109. : MSG.QUIT ( -- )
  110.     jd_quit jdmsg ..! jd_opcode
  111.     jdmsg msg.send msg.recv drop
  112. ;
  113.  
  114. : TEST.SEND ( -- )
  115. \ Make a reply port.
  116.     0" dmsg_fore" msg.make
  117.     port-made @  >abs jdmsg .. jdmsg ..! mn_ReplyPort
  118. \ Find port created by background task.
  119.     0" dmsg_back" msg.findport
  120. \ Send messages to background.
  121.     " Hello!" msg.type
  122.     " Characters coming from other window!" msg.type
  123.     3 4 msg.add  ." 3 4 = " . cr
  124.     ." Type here, 'q' to stop." cr
  125.     BEGIN
  126.         key dup msg.emit
  127.         tolower ascii q =
  128.     UNTIL
  129.     msg.quit
  130.     msg.term
  131. ;
  132.  
  133. : TEST.RECV  ( -- )
  134.     0" dmsg_back" msg.make
  135.     msg-quit off
  136.     BEGIN
  137.         msg.recv
  138.         dup msg.exec
  139.         ReplyMsg()
  140.         msg-quit @
  141.     UNTIL
  142.     msg.term
  143. ;
  144.  
  145. cr cr
  146. ." Run 2 separate images of JForth! Separate windows." cr
  147. ." In one, enter:         TEST.RECV" cr
  148. ." In the other, enter:   TEST.SEND" cr
  149.